COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY EXPPIC
C00004 ENDMK
C⊗;
ENTRY EXPPIC;
BEGIN "EXPAND"
REQUIRE "PICBUF.DCL" SOURCE!FILE;
SIMPLE INTERNAL INTEGER PROCEDURE EXPPIC(INTEGER FACTOR, IBUF);
    BEGIN "EXPPIC"
    INTEGER OBUF,IPTR,OPTR,R,C,F,NEWR,RLIM,CLIM,VAL,WPR;
    GETBUF(FACTOR*(RLIM←ROWS(IBUF)),FACTOR*(CLIM←COLMS(IBUF)),BYTSZ(IBUF),OBUF←FNDBUF);
    PUTSUB((ISUBST(IBUF)-1)*FACTOR+1,(JSUBST(IBUF)-1)*FACTOR+1,OBUF);
    COPHDR(IBUF,OBUF);
    WPR←((FACTOR*CLIM-1)%(36%BYTSZ(IBUF)))+1;
    FOR R←1 STEP 1 UNTIL RLIM DO
	BEGIN "EACH ROW"
	IPTR←INPTR(R,1,IBUF);
	NEWR←(R-1)*FACTOR+1;
	OPTR←OUTPTR(NEWR,1,OBUF);
	FOR C←1 STEP 1 UNTIL CLIM DO
	    BEGIN
	    VAL←ILDB(IPTR);
	    FOR F←1 STEP 1 UNTIL FACTOR DO IDPB(VAL,OPTR);
	    END;
	FOR F←2 STEP 1 UNTIL FACTOR DO ARRBLT(MEMORY[OUTPTR(NEWR+F-1,1,OBUF) LAND '777777],MEMORY[OUTPTR(NEWR,1,OBUF) LAND '777777],WPR);
	END "EACH ROW";
    RETURN(OBUF);
    END;
END;